home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / sources.lha / sources / sys / unix.t < prev    next >
Text File  |  1988-02-05  |  4KB  |  110 lines
  1. (herald unix (env tsys))
  2.  
  3. ;;; Copyright (c) 1985 Yale University
  4. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  5. ;;; This material was developed by the T Project at the Yale University Computer 
  6. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  7. ;;; and to use it for any purpose is granted, subject to the following restric-
  8. ;;; tions and understandings.
  9. ;;; 1. Any copy made of this software must include this copyright notice in full.
  10. ;;; 2. Users of this software agree to make their best efforts (a) to return
  11. ;;;    to the T Project at Yale any improvements or extensions that they make,
  12. ;;;    so that these may be included in future releases; and (b) to inform
  13. ;;;    the T Project of noteworthy uses of this software.
  14. ;;; 3. All materials developed as a consequence of the use of this software
  15. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  16. ;;;    of acknowledging credit in academic research.
  17. ;;; 4. Yale has made no warrantee or representation that the operation of
  18. ;;;    this software will be error-free, and Yale is under no obligation to
  19. ;;;    provide any services, by way of maintenance, update, or otherwise.
  20. ;;; 5. In conjunction with products arising from the use of this material,
  21. ;;;    there shall be no use of the name of the Yale University nor of any
  22. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  23. ;;;    without prior written consent from Yale in each case.
  24. ;;;
  25.  
  26. ;;;; UNIX interface
  27.  
  28. ;;; Operating System Descriptor
  29.  
  30. (define local-os
  31.   (lambda ()
  32.     (object nil
  33.       ((os-type self)               'unix)
  34.       ((unix-os? self)             '#t)
  35.       ((print-type-string self)     "Operating-system"))))
  36.  
  37. ;;; Names of standard places to find things
  38.  
  39. ;;; The T-SYSTEM-DIRECTORY is the place where the various files 
  40. ;;; (possibily) needed to startup the system are found, e.g.
  41. ;;; the image file, the fix file(s), the configuration file ...
  42.  
  43. (define (the-t-system-directory)
  44.   'tsystem)
  45.  
  46. ;;; The INIT-FILE-DIRECTORY is the directory in which the user's
  47. ;;; initialization file should be located.
  48.  
  49. (define (the-init-file-directory)
  50.   'home)
  51.  
  52. ;;; LUSER-TYPED-EOF-AT-TOP-LEVEL is a system dependent exception
  53. ;;; which occurs when the REPL gets an EOF.
  54. ;++ Bug: people might move ^Z to some other key.
  55.  
  56. (define (luser-typed-eof-at-top-level . args)
  57.   (ignore args)
  58.   (format (error-output)
  59.           "** Use ^Z or (STOP) to suspend, or (EXIT) to exit.~%"))
  60.  
  61. ;;; Boot-args offsets.  Boot-args is a system-global which is
  62. ;;; passed to big_bang on system startup.
  63.  
  64.  
  65.  (define-constant boot/argc      4)
  66.  (define-constant boot/argv      5)
  67.  
  68. ;;; Command line        
  69.  
  70.  
  71. (define (command-line)
  72.   (let* ((boot-args (system-global slink/boot-args))
  73.          (argc (mref-integer boot-args (fx* boot/argc 4)))
  74.          (argv (gc-pair->extend (gc-pair->extend (vref boot-args boot/argv)))))
  75.     (do ((i (fx- argc 1) (fx- i 1))
  76.          (l '() (cons (asciz->string (extend-elt argv i)) l)))
  77.         ((fx< i 0) l))))
  78.  
  79. (define (asciz->string asciz)
  80.   (receive (asciz offset)
  81.     (xcase (descriptor-tag asciz)
  82.       ((0) (return (gc-pair->extend (gc-pair->extend asciz)) 0))  ; subtract 2
  83.       ((1) (return (gc-extend->pair asciz) 3))                    ; add 1
  84.       ((2) (return asciz 2))                                      ; OK
  85.       ((3) (return (gc-pair->extend asciz) 1)))                   ; subtract 1
  86.     (do ((i 0 (fx+ i 1)))
  87.         ((fx= (mref-8-u asciz (fx- i offset)) 0)
  88.          (let ((str (make-string i)))
  89.            (do ((i (fx- i 1) (fx- i 1)))
  90.                ((fx< i 0) str)
  91.              (set (mref-8-u (string-text str) i)
  92.                   (mref-8-u asciz (fx- i offset)))))))))
  93.  
  94.  
  95.  
  96. (define (string->asciz! string)
  97.   (let ((len (string-length string)))
  98.     (cond ((fx< len (text-length (string-text string)))
  99.             ;; this could really be much more liberal
  100.             ;; if it wanted to be hairy
  101.             (set (string-elt string len) #\null)
  102.             string)
  103.           (else
  104.            (let ((new-string (make-string (fx+ 1 len))))
  105.              (string-replace new-string string len)
  106.              (set (string-elt new-string len) #\null)
  107.              new-string)))))
  108.  
  109.  
  110.